home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / FACIL2.4TH < prev    next >
Text File  |  1994-10-30  |  1KB  |  30 lines
  1. \ Forth Compiler, ANS FORTH FACILITY WORDS
  2. \ Copyright 1994 by Thomas Almy. All rights reserved.
  3. \ Include this file before FORTHLIB
  4. \ When used with DISPLAY, include DISPLAY2 before FACIL2
  5. 10 HEX
  6. UNDEF AT-XY CODE AT-XY
  7.   AL DH MOV  BL DL MOV  BH BH XOR  2 # AH MOV  10 INT  RET END-CODE [THEN]
  8. UNDEF PAGE CODE PAGE
  9.   CX CX XOR CX ES >SEG  ES: 44A [] DL MOV DL DEC ES: 484 [] DH MOV
  10.   DH DX OR =0 IF, 18 # DH MOV THEN, 7 # BH MOV 600 # AX MOV
  11.   10 INT  RET  END-CODE  [THEN]
  12. U: MS  [DECIMAL] 182 10000  [HEX] */  0  0 46C 2@L SWAP D+
  13.        BEGIN 2DUP 0 46C 2@L SWAP D< UNTIL 2DROP ;
  14. UNDEF TIME&DATE  CODE TIME&DATE  SI POP
  15. 2C # AH MOV  21 INT  AX AX XOR  DH AL MOV AX PUSH
  16. CL AL MOV AX PUSH  CH AL MOV AX PUSH
  17. 2A # AH MOV  21 INT  AX AX XOR  DL AL MOV AX PUSH
  18. DH AL MOV AX PUSH CX PUSH  SI JMPI END-CODE [THEN]
  19. ?DEFINE EKEY ?DEFINE EKEY? OR [IF] \ define these if extended keys used
  20. VARIABLE pchr -1 pchr !
  21. U: KEY  pchr @ 0< 0= IF pchr @ pchr ON EXIT THEN
  22.   BEGIN EKEY EKEY>CHAR 0= WHILE DROP REPEAT ;
  23. U: KEY? pchr @ 0< 0= IF TRUE EXIT THEN
  24.   BEGIN EKEY? WHILE EKEY EKEY>CHAR IF pchr ! TRUE EXIT THEN DROP REPEAT FALSE ;
  25. [THEN]
  26. U: EKEY>CHAR DUP 100 >= IF DUP 103 = IF DROP 0 TRUE EXIT THEN FALSE EXIT THEN TRUE ;
  27. U: EKEY 0 7 BDOS ?DUP 0= IF  0 7 BDOS 100 + THEN ;
  28. U: EKEY? 0 0B BDOS 0<> ;
  29. 0A = [IF] DECIMAL [THEN]
  30.